home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual dBase v5.5 / SAMPLES1.PAK / CAL.WFM < prev    next >
Text File  |  1995-07-18  |  31KB  |  1,088 lines
  1. ********************************************************************************
  2. *  PROGRAM:      Cal.wfm
  3. *
  4. *  WRITTEN BY:   Borland Samples Group
  5. *
  6. *  DATE:         5/93
  7. *
  8. *  UPDATED:      6/95
  9. *
  10. *  REVISION:     $Revision:   2.86  $
  11. *
  12. *  VERSION:      Visual dBASE
  13. *
  14. *  DESCRIPTION:  This file contains a calculator form.  This calculator
  15. *                contains pushbuttons for numeric input and operations.  It also
  16. *                contains 2 entryfields -- the main display, showing the current
  17. *                calculation, and a memory display, showing current memory
  18. *                contents.  Calculations can be performed in either decimal
  19. *                or hexadecimal systems.
  20. *
  21. *  PARAMETERS:   None
  22. *
  23. *  CALLS:        Buttons.cc
  24. *
  25. *  USAGE:        DO Cal.wfm
  26. *
  27. ********************************************************************************
  28. #define MAX_DEC_DIGITS      18
  29. #define MAX_HEX_DIGITS       8
  30. #define DISPLAY_LEN         18
  31. #define HEX_OVERFLOW        2^32
  32. #define DEC_OVERFLOW        10^18
  33.  
  34. create session   && there are no tables in this program, but
  35.                  && this line ensures that the variable names used
  36.                  && here don't refer to any tables opened previously
  37. set talk off
  38. set ldCheck off
  39.  
  40. ** END HEADER -- do not remove this line*
  41. * Generated on 07/11/95
  42. *
  43. parameter bModal
  44. local f
  45. f = new CALFORM()
  46. if (bModal)
  47.    f.mdi = .F. && ensure not MDI
  48.    f.ReadModal()
  49. else
  50.    f.Open()
  51. endif
  52. CLASS CALFORM OF FORM
  53.    Set Procedure To &_dbwinhome.samples\BUTTONS.CC additive
  54.    this.OnOpen = CLASS::ONOPEN
  55.    this.OnGotFocus = CLASS::ONGOTFOCUS
  56.    this.Width = 34
  57.    this.OnClose = CLASS::ONCLOSE
  58.    this.Text = "Calculator"
  59.    this.Top = 0.7646
  60.    this.Maximize = .F.
  61.    this.Minimize = .F.
  62.    this.Left = 13.5
  63.    this.ColorNormal = "BTNTEXT/BTNFACE"
  64.    this.MousePointer = 1
  65.    this.Height = 11.2939
  66.  
  67.    DEFINE RECTANGLE RECTANGLE2 OF THIS;
  68.        PROPERTY;
  69.          Width 33.0068,;
  70.          Text "",;
  71.          Top 8.3516,;
  72.          Left 0.6592,;
  73.          BorderStyle 1,;
  74.          Height 1.707
  75.  
  76.    DEFINE RECTANGLE RECTANGLE1 OF THIS;
  77.        PROPERTY;
  78.          Width 33.0068,;
  79.          FontBold .F.,;
  80.          Text "",;
  81.          Top 2.1758,;
  82.          Left 0.6592,;
  83.          BorderStyle 1,;
  84.          Height 6.1768
  85.  
  86.    DEFINE ENTRYFIELD DISPLAY OF THIS;
  87.        PROPERTY;
  88.          FontName "Arial",;
  89.          Width 33.0068,;
  90.          Function "J",;
  91.          Top 1.1172,;
  92.          Enabled .F.,;
  93.          Left 0.6592,;
  94.          ColorNormal "N/BG*",;
  95.          Value "                 0",;
  96.          FontSize 12,;
  97.          Height 1.1768
  98.  
  99.    DEFINE PUSHBUTTON B7 OF THIS;
  100.        PROPERTY;
  101.          FontName "Arial",;
  102.          Width 4.0205,;
  103.          Group .T.,;
  104.          Text "7",;
  105.          Top 2.4688,;
  106.          Left 1.9795,;
  107.          OnClick CLASS::NUMERIC_CLICK,;
  108.          Height 1.1777
  109.  
  110.    DEFINE PUSHBUTTON B8 OF THIS;
  111.        PROPERTY;
  112.          FontName "Arial",;
  113.          Width 4,;
  114.          Group .T.,;
  115.          Text "8",;
  116.          Top 2.4688,;
  117.          Left 6.5,;
  118.          OnClick CLASS::NUMERIC_CLICK,;
  119.          Height 1.1777
  120.  
  121.    DEFINE PUSHBUTTON B9 OF THIS;
  122.        PROPERTY;
  123.          FontName "Arial",;
  124.          Width 4,;
  125.          Group .T.,;
  126.          Text "9",;
  127.          Top 2.4688,;
  128.          Left 11,;
  129.          OnClick CLASS::NUMERIC_CLICK,;
  130.          Height 1.1777
  131.  
  132.    DEFINE PUSHBUTTON B4 OF THIS;
  133.        PROPERTY;
  134.          FontName "Arial",;
  135.          Width 4.0205,;
  136.          Group .T.,;
  137.          Text "4",;
  138.          Top 3.9395,;
  139.          Left 1.9795,;
  140.          OnClick CLASS::NUMERIC_CLICK,;
  141.          Height 1.1777
  142.  
  143.    DEFINE PUSHBUTTON B5 OF THIS;
  144.        PROPERTY;
  145.          FontName "Arial",;
  146.          Width 4,;
  147.          Group .T.,;
  148.          Text "5",;
  149.          Top 3.9395,;
  150.          Left 6.5,;
  151.          OnClick CLASS::NUMERIC_CLICK,;
  152.          Height 1.1777
  153.  
  154.    DEFINE PUSHBUTTON B6 OF THIS;
  155.        PROPERTY;
  156.          FontName "Arial",;
  157.          Width 4,;
  158.          Group .T.,;
  159.          Text "6",;
  160.          Top 3.9395,;
  161.          Left 11,;
  162.          OnClick CLASS::NUMERIC_CLICK,;
  163.          Height 1.1777
  164.  
  165.    DEFINE PUSHBUTTON B1 OF THIS;
  166.        PROPERTY;
  167.          FontName "Arial",;
  168.          Width 4.0205,;
  169.          Group .T.,;
  170.          Text "1",;
  171.          Top 5.4102,;
  172.          Left 1.9795,;
  173.          OnClick CLASS::NUMERIC_CLICK,;
  174.          Height 1.1777
  175.  
  176.    DEFINE PUSHBUTTON B2 OF THIS;
  177.        PROPERTY;
  178.          FontName "Arial",;
  179.          Width 4,;
  180.          Group .T.,;
  181.          Text "2",;
  182.          Top 5.4102,;
  183.          Left 6.5,;
  184.          OnClick CLASS::NUMERIC_CLICK,;
  185.          Height 1.1777
  186.  
  187.    DEFINE PUSHBUTTON B3 OF THIS;
  188.        PROPERTY;
  189.          FontName "Arial",;
  190.          Width 4,;
  191.          Group .T.,;
  192.          Text "3",;
  193.          Top 5.4102,;
  194.          Left 11,;
  195.          OnClick CLASS::NUMERIC_CLICK,;
  196.          Height 1.1777
  197.  
  198.    DEFINE PUSHBUTTON OPPLUSMINUS OF THIS;
  199.        PROPERTY;
  200.          FontName "Arial",;
  201.          Width 4.0205,;
  202.          Group .T.,;
  203.          Text "+/-",;
  204.          Top 6.8809,;
  205.          Left 1.9795,;
  206.          OnClick CLASS::PLUSMINUS_CLICK,;
  207.          FontSize 10,;
  208.          Height 1.1777
  209.  
  210.    DEFINE PUSHBUTTON B0 OF THIS;
  211.        PROPERTY;
  212.          FontName "Arial",;
  213.          Width 4,;
  214.          Group .T.,;
  215.          Text "0",;
  216.          Top 6.8809,;
  217.          Left 6.5,;
  218.          OnClick CLASS::NUMERIC_CLICK,;
  219.          Height 1.1777
  220.  
  221.    DEFINE PUSHBUTTON PERIOD OF THIS;
  222.        PROPERTY;
  223.          FontName "Arial",;
  224.          Width 4,;
  225.          Group .T.,;
  226.          Text " ",;
  227.          Top 6.8809,;
  228.          Left 11,;
  229.          OnClick CLASS::PERIOD_CLICK,;
  230.          FontSize 10,;
  231.          Height 1.1777
  232.  
  233.    DEFINE PUSHBUTTON OPPOWER OF THIS;
  234.        PROPERTY;
  235.          FontName "Arial",;
  236.          Width 4,;
  237.          Group .T.,;
  238.          Text "^",;
  239.          Top 2.4688,;
  240.          Left 17,;
  241.          OnClick CLASS::OP_CLICK,;
  242.          FontSize 10,;
  243.          Height 1.1777
  244.  
  245.    DEFINE PUSHBUTTON OPTIMES OF THIS;
  246.        PROPERTY;
  247.          FontName "Arial",;
  248.          Width 4,;
  249.          Group .T.,;
  250.          Text "*",;
  251.          Top 3.9395,;
  252.          Left 17,;
  253.          OnClick CLASS::OP_CLICK,;
  254.          FontSize 10,;
  255.          Height 1.1777
  256.  
  257.    DEFINE PUSHBUTTON OPDIV OF THIS;
  258.        PROPERTY;
  259.          FontName "Arial",;
  260.          Width 4,;
  261.          Group .T.,;
  262.          Text "/",;
  263.          Top 5.4102,;
  264.          Left 17,;
  265.          OnClick CLASS::OP_CLICK,;
  266.          FontSize 10,;
  267.          Height 1.1777
  268.  
  269.    DEFINE PUSHBUTTON OPMINUS OF THIS;
  270.        PROPERTY;
  271.          FontName "Arial",;
  272.          Width 4,;
  273.          Group .T.,;
  274.          Text "-",;
  275.          Top 6.8809,;
  276.          Left 17,;
  277.          OnClick CLASS::OP_CLICK,;
  278.          FontSize 10,;
  279.          Height 1.1777
  280.  
  281.    DEFINE PUSHBUTTON CLEAR OF THIS;
  282.        PROPERTY;
  283.          FontName "Arial",;
  284.          Width 4,;
  285.          FontBold .F.,;
  286.          Group .T.,;
  287.          Text "CE\C",;
  288.          Top 2.4688,;
  289.          Left 21.5,;
  290.          OnClick CLASS::CLEAR_CLICK,;
  291.          ColorNormal "W*/R",;
  292.          FontSize 7,;
  293.          Height 1.1777
  294.  
  295.    DEFINE PUSHBUTTON OPEQUAL OF THIS;
  296.        PROPERTY;
  297.          FontName "Arial",;
  298.          Width 4,;
  299.          Group .T.,;
  300.          Text "=",;
  301.          Top 3.9395,;
  302.          Default .T.,;
  303.          Left 21.5,;
  304.          OnClick CLASS::OP_CLICK,;
  305.          FontSize 10,;
  306.          Height 1.1777
  307.  
  308.    DEFINE PUSHBUTTON OPPLUS OF THIS;
  309.        PROPERTY;
  310.          FontName "Arial",;
  311.          Width 4,;
  312.          Group .T.,;
  313.          Text "+",;
  314.          Top 5.4102,;
  315.          Left 21.5,;
  316.          OnClick CLASS::OP_CLICK,;
  317.          FontSize 10,;
  318.          Height 1.1777
  319.  
  320.    DEFINE PUSHBUTTON HEXDEC OF THIS;
  321.        PROPERTY;
  322.          FontName "Arial",;
  323.          Width 4,;
  324.          FontBold .F.,;
  325.          Group .T.,;
  326.          Text "&Hex",;
  327.          Top 6.8809,;
  328.          Left 21.5,;
  329.          OnClick CLASS::CHANGEHEX,;
  330.          FontSize 7,;
  331.          Height 1.1777
  332.  
  333.    DEFINE PUSHBUTTON MADD OF THIS;
  334.        PROPERTY;
  335.          FontName "Arial",;
  336.          Width 5.002,;
  337.          FontBold .F.,;
  338.          Group .T.,;
  339.          Text "&MAdd",;
  340.          Top 2.4688,;
  341.          Left 27.6641,;
  342.          OnClick CLASS::MEM_CLICK,;
  343.          ColorNormal "W+/B",;
  344.          FontSize 7,;
  345.          Height 1.1777
  346.  
  347.    DEFINE PUSHBUTTON MSUB OF THIS;
  348.        PROPERTY;
  349.          FontName "Arial",;
  350.          Width 5.002,;
  351.          FontBold .F.,;
  352.          Group .T.,;
  353.          Text "M&Sub",;
  354.          Top 3.9395,;
  355.          Left 27.6641,;
  356.          OnClick CLASS::MEM_CLICK,;
  357.          ColorNormal "W+/B",;
  358.          FontSize 7,;
  359.          Height 1.1777
  360.  
  361.    DEFINE PUSHBUTTON MRCL OF THIS;
  362.        PROPERTY;
  363.          FontName "Arial",;
  364.          Width 5.002,;
  365.          FontBold .F.,;
  366.          Group .T.,;
  367.          Text "M&Rcl",;
  368.          Top 5.4102,;
  369.          Left 27.6641,;
  370.          OnClick CLASS::MRCL_PROC,;
  371.          ColorNormal "W+/B",;
  372.          FontSize 7,;
  373.          Height 1.1777
  374.  
  375.    DEFINE PUSHBUTTON MCLR OF THIS;
  376.        PROPERTY;
  377.          FontName "Arial",;
  378.          Width 5.002,;
  379.          FontBold .F.,;
  380.          Group .T.,;
  381.          Text "MClr",;
  382.          Top 6.8809,;
  383.          Left 27.6641,;
  384.          OnClick CLASS::MCLR_PROC,;
  385.          ColorNormal "W+/B",;
  386.          FontSize 7,;
  387.          Height 1.1777
  388.  
  389.    DEFINE PUSHBUTTON B_A OF THIS;
  390.        PROPERTY;
  391.          FontName "Arial",;
  392.          Width 4.0205,;
  393.          Group .T.,;
  394.          Text "&A",;
  395.          Top 8.6465,;
  396.          Enabled .F.,;
  397.          Left 1.9795,;
  398.          OnClick CLASS::NUMERIC_CLICK,;
  399.          Height 1.1768
  400.  
  401.    DEFINE PUSHBUTTON B_B OF THIS;
  402.        PROPERTY;
  403.          FontName "Arial",;
  404.          Width 4.0352,;
  405.          Group .T.,;
  406.          Text "&B",;
  407.          Top 8.6465,;
  408.          Enabled .F.,;
  409.          Left 7.2979,;
  410.          OnClick CLASS::NUMERIC_CLICK,;
  411.          Height 1.1768
  412.  
  413.    DEFINE PUSHBUTTON B_C OF THIS;
  414.        PROPERTY;
  415.          FontName "Arial",;
  416.          Width 4.0684,;
  417.          Group .T.,;
  418.          Text "&C",;
  419.          Top 8.6465,;
  420.          Enabled .F.,;
  421.          Left 12.5977,;
  422.          OnClick CLASS::NUMERIC_CLICK,;
  423.          Height 1.1768
  424.  
  425.    DEFINE PUSHBUTTON B_D OF THIS;
  426.        PROPERTY;
  427.          FontName "Arial",;
  428.          Width 4,;
  429.          Group .T.,;
  430.          Text "&D",;
  431.          Top 8.6465,;
  432.          Enabled .F.,;
  433.          Left 18,;
  434.          OnClick CLASS::NUMERIC_CLICK,;
  435.          Height 1.1768
  436.  
  437.    DEFINE PUSHBUTTON B_E OF THIS;
  438.        PROPERTY;
  439.          FontName "Arial",;
  440.          Width 3.9688,;
  441.          Group .T.,;
  442.          Text "&E",;
  443.          Top 8.6465,;
  444.          Enabled .F.,;
  445.          Left 23.1973,;
  446.          OnClick CLASS::NUMERIC_CLICK,;
  447.          Height 1.1768
  448.  
  449.    DEFINE PUSHBUTTON B_F OF THIS;
  450.        PROPERTY;
  451.          FontName "Arial",;
  452.          Width 4.0684,;
  453.          Group .T.,;
  454.          Text "&F",;
  455.          Top 8.6465,;
  456.          Enabled .F.,;
  457.          Left 28.5977,;
  458.          OnClick CLASS::NUMERIC_CLICK,;
  459.          Height 1.1768
  460.  
  461.    DEFINE ENTRYFIELD MEMORY OF THIS;
  462.        PROPERTY;
  463.          FontName "Arial",;
  464.          Width 33.0068,;
  465.          Function "J",;
  466.          Top 10,;
  467.          Enabled .F.,;
  468.          Left 0.6592,;
  469.          ColorNormal "BtnText/BtnFace",;
  470.          Value "                  ",;
  471.          FontSize 12,;
  472.          Height 1.1758
  473.  
  474.    DEFINE SAMPLEINFOBUTTON CALINFOBUTTON OF THIS;
  475.        PROPERTY;
  476.          Width 3.5,;
  477.          Group .T.,;
  478.          Left 30,;
  479.          Height 1.1758
  480.  
  481.    procedure OnOpen
  482.    ****************************************************************************
  483.  
  484.    set procedure to program(1) additive
  485.  
  486.    this.periodChar = setto("point")       && This is necessary for international
  487.    this.period.text = form.periodChar     && applications
  488.  
  489.    this.OpPlus.Doit = {|a,b|a+b}
  490.    this.OpPlus.precedence = 1
  491.  
  492.    this.OpMinus.Doit = {|a,b|a-b}
  493.    this.OpMinus.precedence = 1
  494.  
  495.    this.OpTimes.Doit = {|a,b|a*b}
  496.    this.OpTimes.precedence = 2
  497.  
  498.    this.OpDiv.Doit = {|a,b|a/b}
  499.    this.OpDiv.precedence = 2
  500.  
  501.    this.OpPower.Doit = {|a,b|a^b}
  502.    this.OpPower.precedence = 3
  503.  
  504.    this.OpEqual.Doit = {|a,b|;}
  505.    this.OpEqual.precedence = 0
  506.  
  507.    this.MAdd.Doit = {|a,b|a+b}
  508.    this.MAdd.precedence = 1
  509.  
  510.    this.MSub.Doit = {|a,b|a-b}
  511.    this.MSub.precedence = 1
  512.  
  513.                               && Stack for storing operation states
  514.    this.operationStack = new OperationStackClass()
  515.  
  516.    this.hex = .F.             && In hex or decimal mode
  517.    this.decPlaces = 1         && Start with minimum decimal places
  518.                               && Most decimal places in an operand
  519.    this.mostDecPlaces = 1
  520.    this.beforePeriod = .T.    && Add numbers before or after decimal pt.
  521.    this.lastKeyOperator = .F.
  522.    this.DefineBackgroundTexts()
  523.  
  524.    this.Clear.OnClick()
  525.    this.MClr.OnClick()
  526.  
  527.    this.calInfoButton.sampleName = "Cal.wfm"
  528.  
  529.  
  530.    ****************************************************************************
  531.  
  532.    procedure OnClose
  533.  
  534.    * Clean up
  535.    ****************************************************************************
  536.  
  537.    close procedure program(1)
  538.  
  539.  
  540.    ****************************************************************************
  541.  
  542.    procedure OnGotFocus
  543.  
  544.    * Make sure decimal places is correct every time this form gets focus.
  545.    ****************************************************************************
  546.  
  547.    set decimals to form.decPlaces
  548.  
  549.  
  550.  
  551.    ****************************************************************************
  552.  
  553.    procedure DefineBackgroundTexts
  554.  
  555.    * Define texts behind non-alphabetic characters, so the picks for the text
  556.    * will execute the onclick for these buttons, and button text doesn't
  557.    * look cluttered and strange.
  558.    ****************************************************************************
  559.  
  560.    CLASS::DefineText(this.b1)
  561.    CLASS::DefineText(this.b2)
  562.    CLASS::DefineText(this.b3)
  563.    CLASS::DefineText(this.b4)
  564.    CLASS::DefineText(this.b5)
  565.    CLASS::DefineText(this.b6)
  566.    CLASS::DefineText(this.b7)
  567.    CLASS::DefineText(this.b8)
  568.    CLASS::DefineText(this.b9)
  569.    CLASS::DefineText(this.b0)
  570.    CLASS::DefineText(this.period)
  571.    CLASS::DefineText(this.opPower)
  572.    CLASS::DefineText(this.opTimes)
  573.    CLASS::DefineText(this.opDiv)
  574.    CLASS::DefineText(this.opMinus)
  575.    CLASS::DefineText(this.opPlus)
  576.    CLASS::DefineText(this.opEqual)
  577.  
  578.  
  579.    ****************************************************************************
  580.  
  581.    procedure DefineText(button)
  582.  
  583.    * Define text to appear behind button.  This text will be before the button
  584.    * in the tabbing order.
  585.    ****************************************************************************
  586.    private textName
  587.  
  588.    textName = button.name + "Text"
  589.    define text &textName of this;
  590.       property;
  591.          top button.top,;
  592.          left button.left,;
  593.          text "&" + button.text,;
  594.          width 3,;
  595.          before button
  596.  
  597.  
  598.    ****************************************************************************
  599.  
  600.    procedure ChangeHex
  601.  
  602.    * Toggle from/to Hex display mode.
  603.    ****************************************************************************
  604.    local value,memValue,dispFraction,memFraction
  605.  
  606.    * Get values in display and memory before changing hex indicator
  607.    value = CLASS::NumVal(form.display.value)
  608.    memValue = CLASS::NumVal(form.memory.value)
  609.    form.beforePeriod = .T.
  610.    set decimals to form.decPlaces
  611.    dispFraction = val(substr(form.display.value,;
  612.                              at(form.periodChar, form.display.value)))
  613.    memFraction = val(substr(form.memory.value,;
  614.                             at(form.periodChar, form.memory.value)))
  615.  
  616.    form.hex = .not. form.hex
  617.    this.text = iif(form.hex, "Dec", "&Hex")
  618.  
  619.    * Enable/disable hex letter digits
  620.    store form.hex to ;
  621.       form.B_A.enabled, form.B_B.enabled, form.B_C.enabled,;
  622.       form.B_D.enabled, form.B_E.enabled, form.B_F.enabled
  623.  
  624.    * Enable/disable keys not applicable to hex calculations
  625.    store .not. form.hex to form.opPlusMinus.enabled, form.period.enabled
  626.  
  627.    if abs(value) >= HEX_OVERFLOW
  628.       *** Temporary
  629.       form.display.value = space(DISPLAY_LEN - MAX_HEX_DIGITS) +;
  630.                               replicate("*", MAX_HEX_DIGITS)
  631.    else
  632.       form.display.value = CLASS::CharVal(value + dispFraction)
  633.    endif
  634.    if abs(memValue) >= HEX_OVERFLOW
  635.       form.memory.value  = space(DISPLAY_LEN - MAX_HEX_DIGITS) +;
  636.                               replicate("*", MAX_HEX_DIGITS)
  637.    else
  638.       form.memory.value = CLASS::CharVal(memValue + memFraction)
  639.    endif
  640.  
  641.  
  642.    ****************************************************************************
  643.  
  644.    procedure Numeric_Click
  645.  
  646.    * Process a digit.
  647.    ****************************************************************************
  648.    local num
  649.  
  650.    if form.lastKeyOperator
  651.       form.LastKeyOperator = .F.
  652.       form.beforePeriod = .T.
  653.       form.display.value = space(MAX_DEC_DIGITS - 1) +;
  654.                               CLASS::DisplayValue(this.text)
  655.    else
  656.       do case
  657.          case CLASS::DisplayFull()
  658.             ??chr(7)
  659.          case form.beforePeriod
  660.             * Only want rightmost DISPLAY_LEN characters
  661.             form.display.value = right(;
  662.                                     CLASS::DisplayValue(form.display.value) +;
  663.                                     CLASS::DisplayValue(this.text), DISPLAY_LEN)
  664.          otherwise
  665.             form.display.value = CLASS::AddAfterPeriod(;
  666.                                     CLASS::DisplayValue(this.text))
  667.       endcase
  668.    endif
  669.    form.opEqual.SetFocus()
  670.  
  671.  
  672.    ****************************************************************************
  673.  
  674.    procedure Period_Click
  675.  
  676.    * Process decimal point.
  677.    ****************************************************************************
  678.  
  679.    if form.beforePeriod .and. .not. form.hex
  680.       form.beforePeriod = .F.
  681.       form.decPlaces = 1
  682.       set decimals to 1
  683.       if form.lastKeyOperator
  684.          form.LastKeyOperator = .F.
  685.          form.display.value = space(MAX_DEC_DIGITS - 1) + form.periodChar
  686.       else
  687.          form.display.value = CLASS::AddAfterPeriod(form.periodChar)
  688.       endif
  689.    endif
  690.  
  691.  
  692.    ****************************************************************************
  693.  
  694.    procedure Op_Click
  695.  
  696.    * Process operator.
  697.    ****************************************************************************
  698.    private lastOperation, lastOp, lastValue, tempOpList, tempThis
  699.  
  700.    if form.LastKeyOperator .or. form.operationStack.IsEmpty()
  701.       form.lastValue = CLASS::NumVal(form.display.value)
  702.    else
  703.       * Process all previous operations with >= precedence
  704.       do while form.operationStack.PrevPrecedenceGreaterOrEqual(this.precedence)
  705.          lastOperation = form.operationStack.Pop()
  706.          if lastOperation.GetPrecedence() > 0        && Don't process =
  707.             lastOp = lastOperation.GetOp()
  708.             lastValue = lastOperation.GetValue()
  709.             set decimals to form.mostDecPlaces
  710.             form.lastValue = lastOp(lastValue, CLASS::NumVal(form.display.value))
  711.  
  712.             form.display.value = CLASS::CharVal(form.lastValue)
  713.             form.decPlaces = 1
  714.             set decimals to 1
  715.          endif
  716.       enddo
  717.    endif
  718.    form.beforePeriod = .T.
  719.    form.lastKeyOperator = .T.
  720.  
  721.    tempThis = this
  722.    tempThis.value = CLASS::NumVal(form.display.value)
  723.  
  724.    form.operationStack.Push(tempThis)      && Problem with passing "this"
  725.  
  726.  
  727.    ****************************************************************************
  728.  
  729.    procedure Mem_Click
  730.  
  731.    * Process a memory action button.
  732.    ****************************************************************************
  733.    local result
  734.  
  735.    result = this.Doit(CLASS::NumVal(form.memory.value),;
  736.                       CLASS::NumVal(form.display.value))
  737.    form.memory.value = CLASS::CharVal(result)
  738.  
  739.  
  740.    ****************************************************************************
  741.  
  742.    procedure MClr_Proc
  743.  
  744.    * Clear memory.
  745.    ****************************************************************************
  746.  
  747.    form.lastKeyOperator = .T.
  748.    form.memory.value = space(MAX_DEC_DIGITS - 1) + "0"
  749.  
  750.  
  751.    ****************************************************************************
  752.  
  753.    procedure MRcl_Proc
  754.  
  755.    * Recall from memory.
  756.    ****************************************************************************
  757.  
  758.    if form.lastKeyOperator
  759.       form.LastKeyOperator = .F.
  760.       form.beforePeriod = .T.
  761.       form.lastValue = CLASS::NumVal(form.display.value)
  762.       form.display.value = form.memory.value
  763.    else
  764.       form.lastValue = CLASS::NumVal(form.display.value)
  765.       form.display.value = form.memory.value
  766.    endif
  767.  
  768.  
  769.    ****************************************************************************
  770.  
  771.    procedure Clear_Click
  772.  
  773.    * Clear everything.
  774.    ****************************************************************************
  775.  
  776.    form.operationStack.Initialize()     && Create empty operation stack
  777.    form.lastValue = 0                   && Clear value
  778.    form.lastKeyOperator = .F.           && Start with no operator keys pressed
  779.    form.decPlaces = 1                   && Initial decimal places
  780.    set decimals to 1
  781.    form.mostDecPlaces = 1
  782.    form.display.value = space(MAX_DEC_DIGITS - 1) + "0"
  783.    form.beforePeriod = .T.              && Start with whole number entry
  784.  
  785.  
  786.    ****************************************************************************
  787.  
  788.    procedure PlusMinus_Click
  789.  
  790.    * Toggle sign of number in display.
  791.    ****************************************************************************
  792.    local num
  793.  
  794.    if .not. form.hex
  795.       num = CLASS::NumVal(form.display.value)
  796.       form.display.value = CLASS::CharVal(num * -1)
  797.       form.LastKeyOperator = .F.
  798.    endif
  799.  
  800.  
  801.  
  802.  
  803.  
  804.    *******************************************************************************
  805.  
  806.    function DisplayFull
  807.  
  808.    * Check if display already has MAX_DEC_DIGITS digits in it
  809.    *******************************************************************************
  810.    private isFull, maxValueLen
  811.  
  812.    maxValueLen = iif(form.hex, MAX_HEX_DIGITS, MAX_DEC_DIGITS)
  813.  
  814.    * Check if leftmost digit in current display = " "
  815.    isFull = .not. empty(left(right(form.display.value, maxValueLen), 1))
  816.  
  817.    return isFull
  818.  
  819.  
  820.  
  821.    *******************************************************************************
  822.  
  823.    function AddAfterPeriod(char)
  824.  
  825.    * Add fractional digits after decimal point.
  826.    *******************************************************************************
  827.  
  828.    form.decPlaces = form.decPlaces + 1
  829.    set decimals to form.decPlaces
  830.    form.mostDecPlaces = max(form.decPlaces, form.mostDecPlaces)
  831.  
  832.    return CLASS::DisplayValue(form.display.value) + char
  833.  
  834.  
  835.  
  836.    *******************************************************************************
  837.  
  838.    function DisplayValue(value)
  839.  
  840.    *  Display value without the pick character.
  841.    *******************************************************************************
  842.    private num, pickLoc
  843.  
  844.    num = value
  845.    pickLoc = at("&",num)
  846.    do case
  847.       case pickLoc <> 0
  848.          num = stuff(num,pickLoc,1,"")
  849.       case right(num,2) = " 0"
  850.          num = space(MAX_DEC_DIGITS)
  851.       case left(num,1) = " "
  852.          num = substr(num,2)
  853.    endcase
  854.  
  855.    return num
  856.  
  857.  
  858.  
  859.    *******************************************************************************
  860.  
  861.    function CharVal(num)
  862.  
  863.    * Make a string out of a numeric value in current hex/dec mode
  864.    *******************************************************************************
  865.    private string, fractionVal
  866.  
  867.    if form.hex
  868.       if abs(num) >= HEX_OVERFLOW
  869.          string = replicate("*", MAX_HEX_DIGITS)
  870.       else
  871.          string = itoh(num)
  872.          string = space(MAX_DEC_DIGITS - len(string)) + string
  873.       endif
  874.    else
  875.       if abs(num) >= DEC_OVERFLOW
  876.          string = replicate("*", MAX_DEC_DIGITS)
  877.       else
  878.          string = str(num, MAX_DEC_DIGITS, form.decPlaces)
  879.          if val(right(string, form.decPlaces)) = 0      && If fraction = 0
  880.             string = str(num, MAX_DEC_DIGITS)
  881.          endif
  882.       endif
  883.    endif
  884.  
  885.    return string
  886.  
  887.  
  888.    *******************************************************************************
  889.  
  890.    function NumVal(string)
  891.  
  892.    * Make a number out of a string, in current hex/dec mode.
  893.    *******************************************************************************
  894.    private h, num, periodLoc, s
  895.  
  896.    s = string
  897.    if form.hex
  898.       h = htoi(string)
  899.       num = iif(h >= HEX_OVERFLOW/2, bitxor(h, HEX_OVERFLOW), h)
  900.    else
  901.       periodLoc = at(form.periodChar, s)        && Use point setting for current
  902.       if periodLoc <> 0                         && country
  903.          num = val(stuff(s, periodLoc, 1, "."))
  904.       else
  905.          num = val(s)
  906.       endif
  907.    endif
  908.  
  909.    return num
  910.  
  911.  
  912.  
  913. ENDCLASS
  914.  
  915.  
  916.  
  917.  
  918. *******************************************************************************
  919. *******************************************************************************
  920. CLASS OperationStackClass
  921.  
  922. * This class defines a stack object for storing mathematical operation states.
  923. * This is necessary for using operators that have different precedence, like
  924. * + and *.  This is a stack of OperationStateClass objects.
  925. *******************************************************************************
  926.  
  927.  
  928.    this.Initialize()
  929.  
  930.  
  931.    ****************************************************************************
  932.  
  933.    procedure Initialize
  934.  
  935.    * Create empty stack
  936.    ****************************************************************************
  937.  
  938.                                         && Bottom (and top, at first) of Stack
  939.    this.stackTop = new OperationStateClass()
  940.  
  941.  
  942.    ****************************************************************************
  943.  
  944.    function IsEmpty
  945.  
  946.    * Check if stack is empty
  947.    ****************************************************************************
  948.  
  949.    return empty(this.stackTop.GetNext())        && Empty if no more operations
  950.  
  951.  
  952.    ****************************************************************************
  953.  
  954.    function Pop
  955.  
  956.    * Retrieve last operation state
  957.    ****************************************************************************
  958.    private operation
  959.  
  960.    if empty(this.stackTop.GetNext())
  961.       operation = .F.
  962.       InformationMessage("ERROR: Trying to pop empty stack", "Info")
  963.    else
  964.       operation = this.stackTop
  965.       this.stackTop = this.stackTop.GetNext()
  966.    endif
  967.  
  968.    return operation
  969.  
  970.  
  971.    ****************************************************************************
  972.  
  973.    procedure Push(operation)
  974.  
  975.    * Save last operation state
  976.    ****************************************************************************
  977.    private newStackTop
  978.  
  979.    newStackTop = new operationStateClass()      && Create new operationState
  980.    newStackTop.Assign(operation)                && Assign to it properties of
  981.                                                 && operation
  982.    newStackTop.SetNext(this.stackTop)           && Make current top be next
  983.  
  984.    this.stackTop = newStackTop                  && Make new operation be top
  985.  
  986.  
  987.    ****************************************************************************
  988.  
  989.    function PrevPrecedenceGreaterOrEqual(curPrecedence)
  990.  
  991.    * Retrieve last operation state
  992.    ****************************************************************************
  993.  
  994.    return (this.stackTop.GetPrecedence() >= curPrecedence)
  995.  
  996.  
  997.  
  998. ENDCLASS
  999.  
  1000.  
  1001.  
  1002. *******************************************************************************
  1003. *******************************************************************************
  1004. CLASS OperationStateClass
  1005.  
  1006. * This class defines a single operation state, which is to be stored on the
  1007. * operationStack
  1008. *******************************************************************************
  1009.  
  1010.  
  1011.    this.op = {|a,b|;}          && Operation that accepts 2 operands, but does
  1012.    this.precedence = -1        && nothing
  1013.    this.value = 0
  1014.    this.next = .F.
  1015.  
  1016.  
  1017.  
  1018.    ****************************************************************************
  1019.    procedure GetOp
  1020.    ****************************************************************************
  1021.  
  1022.    return this.op
  1023.  
  1024.  
  1025.    ****************************************************************************
  1026.    procedure SetOp(newOp)
  1027.    ****************************************************************************
  1028.  
  1029.    this.op = newOp
  1030.  
  1031.  
  1032.    ****************************************************************************
  1033.    procedure GetPrecedence
  1034.    ****************************************************************************
  1035.  
  1036.    return this.precedence
  1037.  
  1038.  
  1039.    ****************************************************************************
  1040.    procedure SetPrecedence(newPrecedence)
  1041.    ****************************************************************************
  1042.  
  1043.    this.precedence = newPrecedence
  1044.  
  1045.  
  1046.    ****************************************************************************
  1047.    procedure GetValue
  1048.    ****************************************************************************
  1049.  
  1050.    return this.value
  1051.  
  1052.  
  1053.    ****************************************************************************
  1054.    procedure SetValue(newValue)
  1055.    ****************************************************************************
  1056.  
  1057.    this.value = newValue
  1058.  
  1059.  
  1060.    ****************************************************************************
  1061.    procedure GetNext
  1062.    ****************************************************************************
  1063.  
  1064.    return this.next
  1065.  
  1066.  
  1067.    ****************************************************************************
  1068.    procedure SetNext(newNext)
  1069.    ****************************************************************************
  1070.  
  1071.    this.next = newNext
  1072.  
  1073.  
  1074.    ****************************************************************************
  1075.    procedure Assign(newOperationState)
  1076.    ****************************************************************************
  1077.  
  1078.    this.op = newOperationState.Doit
  1079.    this.precedence = newOperationState.precedence
  1080.    this.value = newOperationState.value
  1081.  
  1082.  
  1083.  
  1084. ENDCLASS
  1085.  
  1086.  
  1087.  
  1088.